home *** CD-ROM | disk | FTP | other *** search
/ Bubka 15 / Bubka 15.iso / utility / win / msch126i.lzh / Src / ClsFile.cls < prev    next >
Encoding:
Visual Basic class definition  |  2001-11-13  |  43.2 KB  |  1,189 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "ClsFile"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. Option Explicit
  17.  
  18. 'é╗é╠æ╝ÆΦÉö
  19. Const MAX_PATH = 260
  20. Const OFS_MAXPATHNAME = 128
  21.  
  22. Const GENERIC_ALL = &H10000000
  23. Const GENERIC_EXECUTE = &H20000000
  24. Const GENERIC_READ = &H80000000
  25. Const GENERIC_WRITE = &H40000000
  26. Const OPEN_ALWAYS = 4
  27. Const OPEN_EXISTING = 3
  28. Const FILE_SHARE_READ = &H1
  29. Const FILE_SHARE_WRITE = &H2
  30. Const FILE_ATTRIBUTE_NORMAL = &H80
  31. Const FILE_BEGIN = 0
  32. Const FILE_CURRENT = 1
  33. Const FILE_END = 2
  34.  
  35. 'é╗é╠æ╝ì\æóæ╠
  36. Private Type FILETIME
  37.     dwLowDateTime As Long
  38.     dwHighDateTime As Long
  39. End Type
  40.  
  41. Private Type WIN32_FIND_DATA
  42.     dwFileAttributes As Long
  43.     ftCreationTime As FILETIME
  44.     ftLastAccessTime As FILETIME
  45.     ftLastWriteTime As FILETIME
  46.     nFileSizeHigh As Long
  47.     nFileSizeLow As Long
  48.     dwReserved0 As Long
  49.     dwReserved1 As Long
  50.     cFileName As String * MAX_PATH
  51.     cAlternate As String * 14
  52. End Type
  53.  
  54. 'é╗é╠æ╝API
  55. Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias _
  56.                         "GetFileVersionInfoA" _
  57.                         (ByVal lptstrFilename As String, _
  58.                          ByVal dwHandle As Long, _
  59.                          ByVal dwLen As Long, _
  60.                          lpData As Any) As Long
  61. Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias _
  62.                         "GetFileVersionInfoSizeA" _
  63.                         (ByVal lptstrFilename As String, _
  64.                          lpdwHandle As Long) As Long
  65. Private Declare Function VerQueryValue Lib "Version.dll" Alias _
  66.                         "VerQueryValueA" _
  67.                         (pBlock As Any, _
  68.                          ByVal lpSubBlock As String, _
  69.                          lplpBuffer As Any, _
  70.                          puLen As Long) As Long
  71. Private Declare Sub MoveMemory Lib "kernel32" Alias _
  72.                     "RtlMoveMemory" _
  73.                     (Destination As Any, _
  74.                      ByVal Source As Long, _
  75.                      ByVal Length As Long)
  76. Private Declare Function FindFirstFile Lib "kernel32" Alias _
  77.                         "FindFirstFileA" _
  78.                         (ByVal lpFileName As String, _
  79.                          lpFindFileData As WIN32_FIND_DATA) As Long
  80. Private Declare Function FindClose Lib "kernel32" _
  81.                         (ByVal hFindFile As Long) As Long
  82. Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
  83.                        (ByVal lpFileName As String, _
  84.                         ByVal dwDesiredAccess As Long, _
  85.                         ByVal dwShareMode As Long, _
  86.                         ByVal lpSecurityAttributes As Long, _
  87.                         ByVal dwCreationDisposition As Long, _
  88.                         ByVal dwFlagsAndAttributes As Long, _
  89.                         ByVal hTemplateFile As Long) As Long
  90. Private Declare Function CloseHandle Lib "kernel32" _
  91.                        (ByVal hObject As Long) As Long
  92. Private Declare Function SetFilePointer Lib "kernel32" _
  93.                        (ByVal hFile As Long, _
  94.                         ByVal lDistanceToMove As Long, _
  95.                         ByVal lpDistanceToMoveHigh As Long, _
  96.                         ByVal dwMoveMethod As Long) As Long
  97. Private Declare Function ReadFile Lib "kernel32" _
  98.                        (ByVal hFile As Long, _
  99.                         lpBuffer As Any, _
  100.                         ByVal nNumberOfBytesToRead As Long, _
  101.                         lpNumberOfBytesRead As Long, _
  102.                         ByVal lpOverlapped As Long) As Long
  103. Private Declare Function GetShortPathName Lib "kernel32" Alias _
  104.                         "GetShortPathNameA" _
  105.                         (ByVal lpszLongPath As String, _
  106.                          ByVal lpszShortPath As String, _
  107.                          ByVal cchBuffer As Long) As Long
  108. Private Declare Function SearchPath Lib "kernel32" Alias _
  109.                         "SearchPathA" _
  110.                         (ByVal lpPath As String, _
  111.                          ByVal lpFileName As String, _
  112.                          ByVal lpExtension As String, _
  113.                          ByVal nBufferLength As Long, _
  114.                          ByVal lpBuffer As String, _
  115.                          ByVal lpFilePart As String) As Long
  116. 'âAü[âJâCâoDLLé╠ÆΦÉö
  117. Const OF_EXIST = &H4000
  118. Const OF_READ = &H0
  119. Const OF_CREATE = &H1000
  120.  
  121. 'âAü[âJâCâoDLLé╠ì\æóæ╠
  122. Private Type OFSTRUCT
  123.     cBytes As Byte
  124.     fFixedDisk As Byte
  125.     nErrCode As Integer
  126.     Reserved1 As Integer
  127.     Reserved2 As Integer
  128.     szPathName(OFS_MAXPATHNAME) As Byte
  129. End Type
  130.  
  131. 'âAü[âJâCâoDLLé╠API
  132. Private Declare Sub LZClose Lib "lz32.dll" (ByVal hfFile As Long)
  133. Private Declare Function LZCopy Lib "lz32.dll" (ByVal hfSource As Long, ByVal hfDest As Long) As Long
  134. 'Private Declare Sub LZDone Lib "lz32" ()
  135. Private Declare Function LZInit Lib "lz32.dll" (ByVal hfSrc As Long) As Long
  136. Private Declare Function LZOpenFile Lib "lz32.dll" Alias "LZOpenFileA" (ByVal lpszFile As String, lpOf As OFSTRUCT, ByVal Style As Long) As Long
  137. Private Declare Function LZRead Lib "lz32.dll" (ByVal hfFile As Long, ByVal lpvBuf As String, ByVal cbread As Long) As Long
  138. Private Declare Function LZSeek Lib "lz32.dll" (ByVal hfFile As Long, ByVal lOffset As Long, ByVal nOrigin As Long) As Long
  139. Private Declare Function LZStart Lib "lz32" () As Long
  140. Private Declare Function GetExpandedName Lib "lz32.dll" Alias "GetExpandedNameA" (ByVal lpszSource As String, ByVal lpszBuffer As String) As Long
  141.  
  142. Private Declare Function BgaCheckArchive Lib "Bga32" (ByVal pszArchive As String, ByVal iMode As Long) As Long
  143. Private Declare Function CabCheckArchive Lib "Cab32" (ByVal pszArchive As String, ByVal iMode As Long) As Long
  144. Private Declare Function TarCheckArchive Lib "Tar32" (ByVal szArcFile As String, ByVal iMode As Integer) As Long
  145. Private Declare Function TarGetArchiveType Lib "Tar32" (ByVal szFileName As String) As Long
  146. Private Declare Function UnlhaCheckArchive Lib "unlha32" (ByVal szFileName As String, ByVal iMode As Long) As Long
  147. Private Declare Function UnZipCheckArchive Lib "unzip32" (ByVal szFileName As String, ByVal iMode As Long) As Long
  148. Private Declare Function Yz1CheckArchive Lib "Yz1" (ByVal strFileName As String, ByVal iMode As Long) As Long
  149. Private Declare Function UnarjCheckArchive Lib "UnArj32j" (ByVal szFileName As String, ByVal iMode As Long) As Long
  150. Private Declare Function UnGCACheckArchive Lib "UnGCA32.dll" (ByVal szFileName As String, ByVal iMode As Long) As Long
  151. Private Declare Function IshFileList Lib "ish32" (ByVal lpszFileName As String, ByVal lpszOutput As String, ByVal wSize As Integer) As Long
  152.  
  153. Private Declare Function TarGetVersion Lib "Tar32" () As Integer
  154. Private Declare Function Tar Lib "Tar32" _
  155.                         (ByVal hWnd As Long, _
  156.                          ByVal szCmdLine As String, _
  157.                          ByVal szOutput As String, _
  158.                          ByVal dwSize As Long) As Long
  159.  
  160. Private Declare Function BgaGetFileCount Lib "Bga32" _
  161.                         (ByVal pszArchive As String) As Integer
  162. Private Declare Function CabGetFileCount Lib "Cab32" _
  163.                         (ByVal pszArchive As String) As Long
  164. Private Declare Function TarGetFileCount Lib "Tar32" _
  165.                         (ByVal szArcFile As String) As Long
  166. Private Declare Function UnlhaGetFileCount Lib "unlha32" _
  167.                         (ByVal szArcFile As String) As Long
  168. Private Declare Function UnZipGetFileCount Lib "unzip32" _
  169.                         (ByVal szArcFile As String) As Long
  170. Private Declare Function Yz1GetFileCount Lib "Yz1" _
  171.                         (ByVal strFileName As String) As Long
  172. Private Declare Function UnarjGetFileCount Lib "UnArj32j" _
  173.                         (ByVal szArcFile As String) As Long
  174. Private Declare Function UnGCAGetFileCount Lib "UnGCA32" _
  175.                         (ByVal szArcFile As String) As Long
  176.                         
  177. 'èOìæÉ╗âAü[âJâCâoDLLé╠ÆΦÉö
  178. Const ERAR_END_ARCHIVE = 10      'ì┼îπé╠RARÅæî╔(ò¬èäÅæî╔)?
  179. Const ERAR_NO_MEMORY = 11        'Å\ò¬é╚âüâéâèé≡èmò█é┼é½é╚é⌐é┴é╜üB
  180. Const ERAR_BAD_DATA = 12         'âRâüâôâgù╠êµé¬é╘é┴ë≤éΩé─éóéΘüBé▄é╜é═üAÅæî╔é¬ë≤éΩé─éóéΘüB
  181. Const ERAR_BAD_ARCHIVE = 13      'É│ôûé╚RARÅæî╔é┼é═é╚éóüB
  182. Const ERAR_UNKNOWN_FORMAT = 14   'Unrar.DLLé┼é═ê╡éªé╚éóRARâtâHü[â}âbâg
  183. Const ERAR_EOPEN = 15            'Åæî╔é≡èJé¡é▒é╞é¬é┼é½é╚éó
  184. Const ERAR_ECREATE = 16          'âtâ@âCâïé≡ì∞éΘé▒é╞é¬é┼é½é╚éóüB
  185. Const ERAR_ECLOSE = 17           'Åæî╔é≡ò┬é╢éΘì█âGâëü[é¬ö¡É╢üB
  186. Const ERAR_EREAD = 18            'ô╟é▌ĵéΦâGâëü[
  187. Const ERAR_EWRITE = 19           'Åæé½ì₧é▌âGâëü[
  188. Const ERAR_SMALL_BUF = 20        'âRâüâôâgâoâbâtâ@é¬Å¼é│é⌐é┴é╜üB
  189. Const ERAR_BAD_PASSWORD = 21     'âpâXâÅü[âhé¬è╘êßé┴é─éóéΘ(Unrar Moduleô╞Ä⌐é╠ÆΦÉö)
  190.  
  191. Const RAR_OM_LIST = 0
  192. Const RAR_OM_EXTRACT = 1
  193. Const RAR_SKIP = 0
  194. Const RAR_TEST = 1
  195. Const RAR_EXTRACT = 2
  196. Const RAR_FILE_PASS = &H4
  197.  
  198. Const ACEERR_MEM = 1        'Å\ò¬é╔âüâéâèé≡èmò█é┼é½é▄é╣é±üB
  199. Const ACEERR_FILES = 2      '
  200. Const ACEERR_FOUND = 3      'âtâ@âCâïé¬î⌐é┬é⌐éΦé▄é╣é±üB
  201. Const ACEERR_FULL = 4       'ë≡ôÇɵé╔Å\ò¬é╚ï≤é½ùeù╩é¬éáéΦé▄é╣é±üB
  202. Const ACEERR_OPEN = 5       'âtâ@âCâïé≡èJé¡é▒é╞é¬é┼é½é▄é╣é±üB
  203. Const ACEERR_READ = 6       'âtâ@âCâïé≡ô╟é▌ĵéΘé▒é╞é¬é┼é½é▄é╣é±üB
  204. Const ACEERR_WRITE = 7      'âfâBâXâNé╔Åæé½ì₧é▐é▒é╞é¬é┼é½é▄é╣é±üB
  205. Const ACEERR_CLINE = 8      '
  206. Const ACEERR_CRC = 9        'Åæî╔é¬ë≤éΩé─éóéΘë┬ö\ɽé¬éáéΦé▄é╖üB
  207. Const ACEERR_OTHER = 10     '
  208. Const ACEERR_EXISTS = 11    'âtâ@âCâïé¬é╖é┼é╔æ╢ì▌é╡é─éóé▄é╖üB
  209. Const ACEERR_END = 128      'ACEÅæî╔é╠âwâbâ_Åεò±é¬î⌐é┬é⌐éΦé▄é╣é±üB
  210. Const ACEERR_HANDLE = 129   'û│î°é╚ânâôâhâïé¬ò╘é┴é─é½é▄é╡é╜
  211. Const ACEERR_CONSTANT = 130 'ÆΦÉöé╠É▌ÆΦé¬è╘êßé┴é─éóé▄é╖üB
  212. Const ACEERR_NOPASSW = 131  'âpâXâÅü[âhé¬É▌ÆΦé│éΩé─éóé▄é╖üB
  213. Const ACEERR_METHOD = 132   'UnAce.DLLé¬âTâ|ü[âgé╡é─éóé╚éóê│Åkò√Ä«é┼é╖üB
  214. Const ACEERR_USER = 255     '
  215.  
  216. Const ACEOPEN_LIST = 0      'âèâXâgé╠Åoù═(âtâ@âCâïû╝é╠é▌)
  217. Const ACEOPEN_EXTRACT = 1   'ë≡ôÇé▄é╜é═Åæî╔é╠É│ôûɽé╠îƒì╕
  218.  
  219. Const ACECMD_SKIP = 0       'Åêù¥é╡é╚éóüH(CRCé╠â`âFâbâNé═é╡é╚éó)
  220. Const ACECMD_TEST = 1       'CRCé≡ùÿùpé╡é╜É│ôûɽîƒì╕é╠ì█ÄgùpüB
  221. Const ACECMD_EXTRACT = 2    'Åæî╔é╠ë≡ôÇ
  222.  
  223. 'èOìæÉ╗âAü[âJâCâoDLLé╠ì\æóæ╠
  224. Private Type RarHeaderData
  225.     ArcName As String * MAX_PATH  'ë≡ôÇé╡é─éóéΘâtâ@âCâï(âtâïâpâXé¬ò╘é┴é─é¡éΘüB)
  226.     FileName As String * MAX_PATH 'ë≡ôÇé╖éΘRARÅæî╔é╔èiö[é│éΩé╜âtâ@âCâïüB
  227.     Flags As Long                 'ùlüXé╚âtâëâO
  228.     PackSize As Long              'ê│ÅkâTâCâY
  229.     UnpSize As Long               'ë≡ôÇâTâCâY
  230.     HostOS As Long                'ì∞ɼOS
  231.     FileCRC As Long               '32BitCRC
  232.     lngFILETIME As Long              'MS-DOSé╠ô·òt
  233.     UnpVer As Long                'ë≡ôÇé┼é½éΘRARé╠âoü[âWâçâô
  234.     Method As Long                'ê│Åkò√û@
  235.     lngFileAttr As Long           'âtâ@âCâïé╠æ«É½
  236.     CmtBuf As String
  237.     CmtBufSize As Long
  238.     CmtSize As Long
  239.     CmtState As Long
  240. End Type
  241.  
  242. Private Type RAROpenArchiveData
  243.     ArcName As String
  244.     OpenMode As Long
  245.     OpenResult As Long
  246.     CmtBuf As String
  247.     CmtBufSize As Long
  248.     CmtSize As Long
  249.     CmtState As Long
  250. End Type
  251.  
  252. Private Type ACEHeaderData
  253.     ArcName As String * MAX_PATH
  254.     FileName As String * MAX_PATH  'Åæî╔ôαé╠âtâ@âCâïû╝
  255.     Flags As Long                  'Åæî╔é╠Åεò±(ârâbâgâIâAÉ┌æ▒)
  256.     PackSize As Long               'Åæî╔ôαé╠âtâ@âCâïé╠ê│ÅkâTâCâY
  257.     UnpSize As Long                'Åæî╔ôαé╠âtâ@âCâïé╠ë≡ôÇâTâCâY
  258.     FileCRC As Long                'Åæî╔ôαé╠âtâ@âCâïé╠32BitCRC
  259.     lngFILETIME As Long               'ô·òté╞Ä₧è╘
  260.     Method As Long                 'ê│Åkò√Ä«
  261.     QUAL As Long                   'ê│Åké╠ôxìçéó
  262.     FileAttrbute As Long           'âtâ@âCâïé╠æ«É½
  263.     CmtBuf As String               '
  264.     CmtBufSize As Long             '
  265.     CmtSize As Long                '
  266.     CmtState As Long               '
  267. End Type
  268.     
  269. Private Type ACEOpenArchiveData
  270.     ArcName As String
  271.     OpenMode As Long
  272.     OpenResult As Long
  273.     Flags As Long
  274.     Host As Long
  275.     AV As String * 51
  276.     CmtBuf As String
  277.     CmtBufSize As Long
  278.     CmtSize As Long
  279.     CmtState As Long
  280. End Type
  281.  
  282. 'èOìæÉ╗âAü[âJâCâoDLLé╠API
  283. Private Declare Function RAROpenArchive Lib "unrar.dll" _
  284.                         (ArchiveData As RAROpenArchiveData) As Long
  285. Private Declare Function RARCloseArchive Lib "unrar.dll" _
  286.                         (ByVal hArcData As Long) As Long
  287. Private Declare Function RARReadHeader Lib "unrar.dll" _
  288.                         (ByVal hArcData As Long, _
  289.                          HeaderData As RarHeaderData) As Long
  290. Private Declare Function RARProcessFile Lib "unrar.dll" _
  291.                         (ByVal hArcData As Long, _
  292.                          ByVal Operation As Long, _
  293.                          ByVal DestPath As String, _
  294.                          ByVal DestName As String) As Long
  295. Private Declare Function ACEOpenArchive Lib "UnACE.dll" _
  296.                         (ACEOpenData As ACEOpenArchiveData) As Long
  297. Private Declare Function ACECloseArchive Lib "UnACE.dll" _
  298.                         (ByVal HandleToArchive As Long) As Long
  299. Private Declare Function ACEReadHeader Lib "UnACE.dll" _
  300.                         (ByVal HandleToArchive As Long, _
  301.                          ACEHeaderRead As ACEHeaderData) As Long
  302. Private Declare Function ACEProcessFile Lib "UnACE.dll" _
  303.                         (ByVal HandleToArchive As Long, _
  304.                          ByVal Operation As Long, _
  305.                          ByVal DestPath As String) As Long
  306. Private Declare Function ACESetPassword Lib "UnACE.dll" _
  307.                         (ByVal HandleToArchive As Long, _
  308.                          ByVal Password As String) As Long
  309.                          
  310. Private mstrFileName As String
  311. Private mTargethWnd As Long
  312. Private mstrOutPut As String
  313. Private mComment As String
  314. Private mCopyRight As String
  315. Public Function GetArcSearch(Optional ByVal lngBufferSize As Long = 131072) As Long
  316. 'âtâ@âCâïâTü[â`âvâìâOâëâÇâvâìâVü[âWââé┼é╖üBÆ╖éó(^^;
  317. 'ëⁿé┤é±æ╬ì⌠é═éáéΦé▄é╣é±(^^;;
  318. 'ò╩û╝Meltschmelzené╠ÉSæƒ
  319.  
  320. 'ò╘éΦÆl
  321. '1 - LHA , 2 - ZIP , 3 - CAB , 4 - RAR , 5 - BZA,GZA , 6 - YZ1 , 7 - ACE , 8 - ARJ
  322. '9 - ISH , 10 - UnGCA , 11 - TAR , 12 - MS-COMPRESS , 200 - âAâNâZâXï╓Ä~ , 201 - âTâCâY0
  323. '0 - ë╜é┼éαû│éóâtâ@âCâï , 20 - FCD , 21 - UPX , 22 - FCD(UDF) , 23 - FCD(COMPRESS)
  324. '24 - FCD(RAW) , 25 - FCD(RAW-COMPRESS)
  325.  
  326.     Dim lngResult As Long
  327.     Dim lngInstr As Long
  328.     Dim Buffer(300) As Byte
  329.     Dim SecondBuf() As Byte
  330.     Dim lngFileHndle As Long
  331.     Dim strResult As String
  332.     Dim ReadByte As Long
  333.     Dim i As Long
  334.     
  335.     If FileLen(mstrFileName) = 0 Then
  336.         GetArcSearch = 201
  337.         Exit Function
  338.     End If
  339.     
  340.     lngFileHndle = CreateFile(mstrFileName, _
  341.                               GENERIC_READ, _
  342.                               FILE_SHARE_READ, _
  343.                               0, OPEN_EXISTING, _
  344.                               FILE_ATTRIBUTE_NORMAL, 0)
  345.                            
  346.     If lngFileHndle = -1 Then
  347.         If IsNotAccessFile = True Then
  348.             GetArcSearch = 200
  349.             Exit Function
  350.         End If
  351.         GetArcSearch = 0
  352.     End If
  353.  
  354.     lngResult = SetFilePointer(lngFileHndle, 0, 0, FILE_BEGIN)
  355.     lngResult = ReadFile(lngFileHndle, Buffer(0), 300, ReadByte, 0)
  356.     lngResult = CloseHandle(lngFileHndle)
  357.     
  358.     If Left$(Trim$(StrConv(Buffer(), vbUnicode)), 4) = "SZDD" Then
  359.         If LzCheckArchiveEx = True Then
  360.             GetArcSearch = 12
  361.             Exit Function
  362.         End If
  363.     End If
  364.  
  365.     If Left$(Trim$(StrConv(Buffer(), vbUnicode)), 2) = "MZ" Then 'Ä⌐î╚ë≡ôÇÅæî╔é╠ÅΩìç
  366.         lngFileHndle = CreateFile(mstrFileName, _
  367.                                   GENERIC_READ, _
  368.                                   FILE_SHARE_READ, _
  369.                                   0, OPEN_EXISTING, _
  370.                                   FILE_ATTRIBUTE_NORMAL, 0)
  371.         ReDim SecondBuf(lngBufferSize)
  372.         lngResult = SetFilePointer(lngFileHndle, 0, 0, FILE_BEGIN)
  373.         lngResult = ReadFile(lngFileHndle, SecondBuf(0), lngBufferSize, ReadByte, 0)
  374.         lngResult = CloseHandle(lngFileHndle)
  375.         
  376.         If InStr(Trim$(StrConv(SecondBuf(), vbUnicode)), "UPX") <> 0 Then
  377.             GetArcSearch = 21
  378.             Exit Function
  379.         End If
  380.         
  381.         If SearchFile("Unlha32.DLL") = True Then
  382.             'LZHé┼é═üAò╢ÄÜù±âTü[â`é═èδî»é┼éáéΘüBé╛é¬üAæ╝é╔ò√û@é═é╚éóé╠é┼üB
  383.             'éóéΓüAHEADER.TXTé≡î│é╔ì∞ɼé╖éΩé╬éóéóé╛é»é╠é▒é╞é┼é╖é»é╟é╦üB
  384.             For i = 0 To 7 '-lh5- éΓ -lh0-é╞éóé┴é╜ò╢ÄÜù±é≡âTü[â`é╡é▄é╖üB
  385.                 lngInstr = InStr(Trim$(StrConv(SecondBuf(), vbUnicode)), "lh" & i)
  386.                 If lngInstr <> 0 Then 'î⌐é┬é⌐é┴é╜ÅΩìç
  387.                     If UnlhaCheckArchive(mstrFileName, 0) Then
  388.                         GetArcSearch = 1
  389.                         Exit Function
  390.                     End If
  391.                 End If
  392.             Next i
  393.             lngInstr = InStr(Trim$(StrConv(SecondBuf(), vbUnicode)), "lhd")
  394.             If lngInstr <> 0 Then 'î⌐é┬é⌐é┴é╜ÅΩìç
  395.                 If UnlhaCheckArchive(mstrFileName, 0) Then
  396.                     GetArcSearch = 1
  397.                     Exit Function
  398.                 End If
  399.             End If
  400.             lngInstr = InStr(Trim$(StrConv(SecondBuf(), vbUnicode)), "lzs")
  401.             If lngInstr <> 0 Then 'î⌐é┬é⌐é┴é╜ÅΩìç
  402.                 If UnlhaCheckArchive(mstrFileName, 0) Then
  403.                     GetArcSearch = 1
  404.                     Exit Function
  405.                 End If
  406.             End If
  407.             lngInstr = InStr(Trim$(StrConv(SecondBuf(), vbUnicode)), "lz4")
  408.             If lngInstr <> 0 Then 'î⌐é┬é⌐é┴é╜ÅΩìç
  409.                 If UnlhaCheckArchive(mstrFileName, 0) Then
  410.                     GetArcSearch = 1
  411.                     Exit Function
  412.                 End If
  413.             End If
  414.             lngInstr = InStr(Trim$(StrConv(SecondBuf(), vbUnicode)), "lz5")
  415.             If lngInstr <> 0 Then 'î⌐é┬é⌐é┴é╜ÅΩìç
  416.                 If UnlhaCheckArchive(mstrFileName, 0) Then
  417.                     GetArcSearch = 1
  418.                     Exit Function
  419.                 End If
  420.             End If
  421.         End If
  422.  
  423.         If SearchFile("UnZip32.DLL") = True Then
  424.             If InStr(Trim$(StrConv(SecondBuf(), vbUnicode)), "PK") <> 0 Then
  425.                 If UnZipCheckArchive(mstrFileName, 0) Then
  426.                     If UnZipGetFileCount(mstrFileName) > 0 Then
  427.                         GetArcSearch = 2
  428.                         Exit Function
  429.                     End If
  430.                 End If
  431.             End If
  432.         End If
  433.         
  434.         If SearchFile("Cab32.DLL") = True Then
  435.             If InStr(Trim$(StrConv(SecondBuf(), vbUnicode)), "MSCF") <> 0 Then
  436.                 If CabCheckArchive(mstrFileName, 0) Then
  437.                     GetArcSearch = 3
  438.                     Exit Function
  439.                 End If
  440.             End If
  441.         End If
  442.         
  443.         If SearchFile("Unrar.DLL") = True Then
  444.             If InStr(Trim$(StrConv(SecondBuf(), vbUnicode)), "Rar!") <> 0 Then
  445.                 lngResult = UnRarCheckArchiveEx
  446.                 Select Case lngResult
  447.                     Case 1, 2
  448.                         GetArcSearch = 4
  449.                         Exit Function
  450.                 End Select
  451.             End If
  452.         End If
  453.         
  454.         If SearchFile("Bga32.DLL") = True Then
  455.             If InStr(Trim$(StrConv(SecondBuf(), vbUnicode)), "BZ2") <> 0 Then
  456.                 If BgaCheckArchive(mstrFileName, 0) Then
  457.                     GetArcSearch = 5
  458.                     Exit Function
  459.                 End If
  460.             ElseIf InStr(Trim$(StrConv(SecondBuf(), vbUnicode)), "GZIP") <> 0 Then
  461.                 If BgaCheckArchive(mstrFileName, 0) Then
  462.                     GetArcSearch = 5
  463.                     Exit Function
  464.                 End If
  465.             End If
  466.         End If
  467.         
  468.         If SearchFile("Yz1.DLL") = True Then
  469.             If InStr(Trim$(StrConv(SecondBuf(), vbUnicode)), "yz01") <> 0 Then
  470.                 If Yz1CheckArchive(mstrFileName, 0) Then
  471.                     GetArcSearch = 6
  472.                     Exit Function
  473.                 End If
  474.             End If
  475.         End If
  476.         
  477.         If SearchFile("Unace.DLL") = True Then
  478.             If InStr(Trim$(StrConv(SecondBuf(), vbUnicode)), "*ACE*") <> 0 Then
  479.                 If UnAceCheckArchiveEx = 0 Then
  480.                     GetArcSearch = 7
  481.                     Exit Function
  482.                 End If
  483.             End If
  484.         End If
  485.         
  486.         If SearchFile("Tar32.DLL") = True Then
  487.             If IsTarBrokenFile = True Then
  488.                 GetArcSearch = 11
  489.                 Exit Function
  490.             Else
  491.                 GetArcSearch = 0
  492.             End If
  493.         End If
  494.         GetArcSearch = 0
  495.     Else
  496.         'Æ╩ÅφÅæî╔é╔æ╬é╖éΘÅêù¥
  497.         strResult = Mid$(Trim$(StrConv(Buffer(), vbUnicode)), 1, 15)
  498.         
  499.         If SearchFile("Tar32.DLL") = True Then
  500.             If IsTarBrokenFile = True Then
  501.                 GetArcSearch = 11
  502.                 Exit Function
  503.             Else
  504.                 GetArcSearch = 0
  505.             End If
  506.         End If
  507.         If SearchFile("Unlha32.DLL") = True Then
  508.             For i = 0 To 7
  509.                 lngInstr = InStr(Trim$(StrConv(Buffer(), vbUnicode)), "lh" & i)
  510.                 If lngInstr <> 0 Then
  511.                     If UnlhaCheckArchive(mstrFileName, 0) Then
  512.                         GetArcSearch = 1
  513.                         Exit Function
  514.                     End If
  515.                 End If
  516.             Next i
  517.             lngInstr = InStr(Trim$(StrConv(Buffer(), vbUnicode)), "lhd")
  518.             If lngInstr <> 0 Then 'î⌐é┬é⌐é┴é╜ÅΩìç
  519.                 If UnlhaCheckArchive(mstrFileName, 0) Then
  520.                     GetArcSearch = 1
  521.                     Exit Function
  522.                 End If
  523.             End If
  524.             lngInstr = InStr(Trim$(StrConv(Buffer(), vbUnicode)), "lzs")
  525.             If lngInstr <> 0 Then 'î⌐é┬é⌐é┴é╜ÅΩìç
  526.                 If UnlhaCheckArchive(mstrFileName, 0) Then
  527.                     GetArcSearch = 1
  528.                     Exit Function
  529.                 End If
  530.             End If
  531.             lngInstr = InStr(Trim$(StrConv(Buffer(), vbUnicode)), "lz4")
  532.             If lngInstr <> 0 Then 'î⌐é┬é⌐é┴é╜ÅΩìç
  533.                 If UnlhaCheckArchive(mstrFileName, 0) Then
  534.                     GetArcSearch = 1
  535.                     Exit Function
  536.                 End If
  537.             End If
  538.             lngInstr = InStr(Trim$(StrConv(Buffer(), vbUnicode)), "lz5")
  539.             If lngInstr <> 0 Then 'î⌐é┬é⌐é┴é╜ÅΩìç
  540.                 If UnlhaCheckArchive(mstrFileName, 0) Then
  541.                     GetArcSearch = 1
  542.                     Exit Function
  543.                 End If
  544.             End If
  545.         End If
  546.         
  547.         If SearchFile("UnZip32.DLL") = True Then
  548.             If InStr(strResult, "PK") <> 0 Then
  549.                 If UnZipCheckArchive(mstrFileName, 0) Then
  550.                     GetArcSearch = 2
  551.                     Exit Function
  552.                 End If
  553.             End If
  554.         End If
  555.         
  556.         If SearchFile("Cab32.DLL") = True Then
  557.             If InStr(strResult, "MSCF") <> 0 Then
  558.                 If CabCheckArchive(mstrFileName, 0) Then
  559.                     GetArcSearch = 3
  560.                     Exit Function
  561.                 End If
  562.             End If
  563.         End If
  564.         
  565.         If SearchFile("Unrar.DLL") = True Then
  566.             If InStr(strResult, "Rar!") <> 0 Then
  567.                 lngResult = UnRarCheckArchiveEx
  568.                 Select Case lngResult
  569.                     Case 1, 2
  570.                         GetArcSearch = 4
  571.                         Exit Function
  572.                 End Select
  573.             End If
  574.         End If
  575.         
  576.         If SearchFile("Bga32.DLL") = True Then
  577.             If InStr(strResult, "BZ2") <> 0 Then
  578.                 If BgaCheckArchive(mstrFileName, 0) Then
  579.                     GetArcSearch = 5
  580.                     Exit Function
  581.                 End If
  582.             ElseIf InStr(strResult, "GZIP") <> 0 Then
  583.                 If BgaCheckArchive(mstrFileName, 0) Then
  584.                     GetArcSearch = 5
  585.                     Exit Function
  586.                 End If
  587.             End If
  588.         End If
  589.         
  590.         If SearchFile("Yz1.DLL") = True Then
  591.             If InStr(strResult, "yz01") <> 0 Then
  592.                 If Yz1CheckArchive(mstrFileName, 0) Then
  593.                     GetArcSearch = 6
  594.                     Exit Function
  595.                 End If
  596.             End If
  597.         End If
  598.         
  599.         If SearchFile("Unace.DLL") = True Then
  600.             If InStr(strResult, "*ACE*") <> 0 Then
  601.                 If UnAceCheckArchiveEx() = 0 Then
  602.                     GetArcSearch = 7
  603.                     Exit Function
  604.                 End If
  605.             End If
  606.         End If
  607.         
  608.         If SearchFile("Unarj32j.DLL") = True Then
  609.             If Hex$(Buffer(0)) = "60" And Hex$(Buffer(1)) = "EA" Then
  610.                 If UnarjCheckArchive(mstrFileName, 0) Then
  611.                     GetArcSearch = 8
  612.                     Exit Function
  613.                 End If
  614.             End If
  615.         End If
  616.         
  617.         If SearchFile("Ish32.DLL") = True Then
  618.             If IshCheckArchiveEx = True Then
  619.                 GetArcSearch = 9
  620.                 Exit Function
  621.             End If
  622.         End If
  623.         
  624.         If SearchFile("UnGCA32.DLL") = True Then
  625.             If UnGCACheckArchive(mstrFileName, 0) = 1 Then
  626.                 GetArcSearch = 10
  627.                 Exit Function
  628.             End If
  629.         End If
  630.     End If
  631.     
  632.     Select Case FCDCheckFile(Buffer())
  633.         Case 1
  634.             If LCase$(GetFileExtention(mstrFileName)) = "fcd" Then
  635.                 GetArcSearch = 20
  636.                 Exit Function
  637.             End If
  638.         Case 2
  639.             If LCase$(GetFileExtention(mstrFileName)) = "fcd" Then
  640.                 GetArcSearch = 22
  641.                 Exit Function
  642.             End If
  643.         Case 3
  644.             If LCase$(GetFileExtention(mstrFileName)) = "fcd" Then
  645.                 GetArcSearch = 23
  646.                 Exit Function
  647.             End If
  648.         Case 4
  649.             If LCase$(GetFileExtention(mstrFileName)) = "fcd" Then
  650.                 GetArcSearch = 24
  651.                 Exit Function
  652.             End If
  653.         Case 5
  654.             If LCase$(GetFileExtention(mstrFileName)) = "fcd" Then
  655.                 GetArcSearch = 25
  656.                 Exit Function
  657.             End If
  658.     End Select
  659.     GetArcSearch = 0
  660. End Function
  661. Public Property Let strOutPut(ByVal vData As String)
  662.     mstrOutPut = vData
  663. End Property
  664. Public Sub WriteBufferToFile(ByVal Buffer As String, Optional ByVal blnOverWrite As Boolean = True)
  665.     On Error GoTo ErrLine
  666.     
  667.     Dim Fnum As Long
  668.     Fnum = FreeFile
  669.     Open mstrOutPut For Binary Access Write As #Fnum
  670.         If blnOverWrite = False Then
  671.             If IsFileExist(mstrOutPut) = True Then
  672.                 If MsgBox("ô»û╝âtâ@âCâïé¬éáéΦé▄é╖üBÅπÅæé½é╡é▄é╖é⌐üH", vbInformation + vbYesNo + vbDefaultButton2) = vbYes Then
  673.                     Put #Fnum, , Buffer
  674.                 End If
  675.             Else
  676.                 Put #Fnum, , Buffer
  677.             End If
  678.         Else
  679.             Put #Fnum, , Buffer
  680.         End If
  681.     Close #Fnum
  682.     Exit Sub
  683. ErrLine:
  684.     MsgBox Error$(Err.number), vbExclamation
  685. End Sub
  686. Public Sub GetExecuteInfo()
  687.     Dim lngDmyHandle As Long
  688.     Dim lngFInfoSize As Long
  689.     Dim bytDmyVrInfo() As Byte
  690.     Dim lngResult As Long
  691.     Dim lngPtrVerInfo As Long
  692.     Dim lngLgthVerInfo As Long
  693.     Dim lngVerInfoTrans As Long
  694.     Dim lngLangValue As Long
  695.     Dim lngCharValue As Long
  696.     Dim strLangSet As String
  697.     Dim strComment As String * 128
  698.     
  699.     lngFInfoSize = GetFileVersionInfoSize(mstrFileName, lngDmyHandle)
  700.     If lngFInfoSize > 0 Then
  701.         ReDim bytDmyVrInfo(lngFInfoSize - 1)
  702.         lngResult = GetFileVersionInfo(mstrFileName, _
  703.                                        0, _
  704.                                        lngFInfoSize, _
  705.                                        bytDmyVrInfo(0))
  706.         lngResult = VerQueryValue(bytDmyVrInfo(0), _
  707.                                   "\VarFileInfo\Translation", _
  708.                                   lngPtrVerInfo, _
  709.                                   lngLgthVerInfo)
  710.         MoveMemory lngVerInfoTrans, _
  711.                    lngPtrVerInfo, _
  712.                    lngLgthVerInfo
  713.         lngLangValue = lngVerInfoTrans And &HFFFF&
  714.         lngCharValue = (lngVerInfoTrans \ 2 ^ 16) And &HFFFF&
  715.         strLangSet = Right$("0000" & Hex$(lngLangValue), 4) & _
  716.                      Right$("0000" & Hex$(lngCharValue), 4)
  717.         lngResult = VerQueryValue(bytDmyVrInfo(0), _
  718.                                   "\StringFileInfo\" & strLangSet & "\ProductName", _
  719.                                   lngPtrVerInfo, _
  720.                                   lngLgthVerInfo)
  721.         MoveMemory ByVal strComment, _
  722.                    lngPtrVerInfo, _
  723.                    lngLgthVerInfo
  724.         mComment = Left$(strComment, InStr(strComment, vbNullChar) - 1)
  725.     End If
  726. End Sub
  727. Public Property Let TargethWnd(ByVal vData As Long)
  728.     mTargethWnd = vData
  729. End Property
  730. Public Property Let strFileName(ByVal vData As String)
  731.     mstrFileName = vData
  732. End Property
  733. Public Property Get CopyRight() As String
  734.     CopyRight = mCopyRight
  735. End Property
  736. Public Property Get Comment() As String
  737.     Select Case Len(mComment)
  738.         Case 0
  739.             Comment = ""
  740.         Case 4
  741.             If Asc(Mid$(mComment, 1, 1)) = 17 Then
  742.                 If Asc(Mid$(mComment, 2, 1)) = 4 Then
  743.                     If Asc(Mid$(mComment, 3, 1)) = 176 Then
  744.                         If Asc(Mid$(mComment, 4, 1)) = 4 Then
  745.                             Comment = ""
  746.                             Exit Property
  747.                         End If
  748.                     End If
  749.                 End If
  750.             End If
  751.             Comment = mComment
  752.         Case Else
  753.             Comment = mComment
  754.     End Select
  755. End Property
  756. Private Function FCDCheckFile(Buffer() As Byte) As Long
  757.     FCDCheckFile = 0
  758.     
  759.     If Buffer(0) = 1 Then
  760.         FCDCheckFile = 3
  761.         Exit Function
  762.     End If
  763.     
  764.     If Buffer(0) = 5 Then
  765.         If Buffer(2) = 6 Then
  766.             Select Case Buffer(4)
  767.                 Case 0
  768.                     If Buffer(5) = 147 Then
  769.                         FCDCheckFile = 4
  770.                         Exit Function
  771.                     End If
  772.                 Case 112
  773.                     If Buffer(5) = 119 Then
  774.                         FCDCheckFile = 5
  775.                         Exit Function
  776.                     End If
  777.             End Select
  778.         End If
  779.     End If
  780.     If Buffer(140) = 70 Then
  781.         If Buffer(141) = 67 Then
  782.             If Buffer(142) = 68 Then
  783.                 If Buffer(143) = 32 Then
  784.                     If Buffer(144) = 86 Then
  785.                         If Buffer(145) = 49 Then
  786.                             If Buffer(146) = 46 Then
  787.                                 If Buffer(147) = 48 Then
  788.                                     FCDCheckFile = 1
  789.                                 End If
  790.                             End If
  791.                         ElseIf Buffer(145) = 52 Then
  792.                             If Buffer(146) = 46 Then
  793.                                 If Buffer(147) = 48 Then
  794.                                     FCDCheckFile = 2
  795.                                 End If
  796.                             End If
  797.                         End If
  798.                     End If
  799.                 End If
  800.             End If
  801.         End If
  802.     End If
  803. End Function
  804. Private Function LzCheckArchiveEx() As Boolean
  805.     Dim lngLzHndle1 As Long
  806.     Dim utdLzStruct As OFSTRUCT
  807.     lngLzHndle1 = LZOpenFile(mstrFileName, utdLzStruct, OF_READ)
  808.     If lngLzHndle1 = 0 Then
  809.         LzCheckArchiveEx = False
  810.     Else
  811.         LzCheckArchiveEx = True
  812.     End If
  813.     Call LZClose(lngLzHndle1)
  814. End Function
  815. Private Function IshCheckArchiveEx() As Boolean
  816.     Dim lngResult As Long
  817.     Dim strBuffer As String
  818.     strBuffer = String$(512, vbNullChar)
  819.     lngResult = IshFileList(mstrFileName, strBuffer, Len(strBuffer))
  820.     If lngResult <> 0 Then
  821.         IshCheckArchiveEx = False
  822.     Else
  823.         IshCheckArchiveEx = True
  824.     End If
  825. End Function
  826. Private Function UnRarCheckArchiveEx(Optional ByVal iMode As Long = 0) As Long
  827.     Dim lngRarhndle As Long
  828.     Dim lngResult As Long
  829.     Dim lngDir As Long
  830.     Dim lngStatus As Long
  831.     Dim intPassFlag As Integer
  832.     Dim utdRar As RAROpenArchiveData
  833.     Dim utdRarHeader As RarHeaderData
  834.     'âtâ@âCâïé¬é╚éóÅΩìçö▓é»éΘüB
  835.     If Len(mstrFileName) = 0 Then
  836.         UnRarCheckArchiveEx = -1
  837.         Exit Function
  838.     End If
  839.     
  840.     With utdRar
  841.         .ArcName = GetShortPath
  842.         .OpenMode = RAR_OM_LIST
  843.         .CmtBuf = String$(256, vbNullChar)
  844.         .CmtBufSize = 256
  845.     End With
  846.     
  847.     lngRarhndle = RAROpenArchive(utdRar)
  848.  
  849.     If lngRarhndle = 0 Then
  850.         lngResult = RARCloseArchive(lngRarhndle)
  851.         UnRarCheckArchiveEx = utdRar.OpenResult
  852.         Exit Function
  853.     End If
  854.     
  855.     lngStatus = RARReadHeader(lngRarhndle, utdRarHeader)
  856.  
  857.     Do Until lngStatus <> 0
  858.         lngResult = utdRarHeader.Flags And RAR_FILE_PASS
  859.         lngDir = utdRarHeader.lngFileAttr And 16
  860.         Select Case iMode
  861.             Case 0
  862.                 If lngResult <> 0 Then
  863.                     intPassFlag = 2
  864.                     Exit Do
  865.                 End If
  866.                 If lngDir = 0 And lngResult = 0 Then Exit Do
  867.                 lngResult = RARProcessFile(lngRarhndle, RAR_SKIP, "", "")
  868.             Case 1, 2
  869.                 lngResult = RARProcessFile(lngRarhndle, RAR_SKIP, "", "")
  870.             Case Else
  871.                 If lngResult <> 0 Then
  872.                     intPassFlag = 2
  873.                     Exit Do
  874.                 End If
  875.                 If lngDir = 0 And lngResult = 0 Then Exit Do
  876.                 lngResult = RARProcessFile(lngRarhndle, RAR_SKIP, "", "")
  877.         End Select
  878.         If lngResult <> 0 Then
  879.             UnRarCheckArchiveEx = lngResult
  880.             lngResult = RARCloseArchive(lngRarhndle)
  881.             Exit Function
  882.         End If
  883.         lngStatus = RARReadHeader(lngRarhndle, utdRarHeader)
  884.         If lngStatus = ERAR_BAD_DATA Then
  885.             UnRarCheckArchiveEx = ERAR_BAD_DATA
  886.             Exit Do
  887.         End If
  888.     Loop
  889.     If intPassFlag = 2 Then
  890.         'âpâXâÅü[âhÅæî╔é╠ÅΩìç
  891.         UnRarCheckArchiveEx = 2
  892.     Else
  893.         UnRarCheckArchiveEx = 1
  894.     End If
  895.     lngResult = RARCloseArchive(lngRarhndle)
  896. End Function
  897. Private Function UnAceCheckArchiveEx() As Long
  898.     Dim UnAcehndle  As Long
  899.     Dim UnAceStatus As Long
  900.     Dim lngResult   As Long
  901.     Dim lngDirFlag  As Long
  902.     Dim utdAce      As ACEOpenArchiveData
  903.     Dim utdHeader   As ACEHeaderData
  904.  
  905.     UnAceCheckArchiveEx = 0
  906.     
  907.     With utdAce
  908.         .ArcName = GetShortPath
  909.         .OpenMode = ACEOPEN_LIST
  910.     End With
  911.  
  912.     UnAcehndle = ACEOpenArchive(utdAce)
  913.     
  914.     If utdAce.OpenResult <> 0 Then
  915.         UnAceCheckArchiveEx = utdAce.OpenResult
  916.         lngResult = ACECloseArchive(UnAcehndle)
  917.         Exit Function
  918.     End If
  919.  
  920.     UnAceStatus = ACEReadHeader(UnAcehndle, utdHeader)
  921.     
  922.     If UnAceStatus <> 0 Then
  923.         UnAceCheckArchiveEx = UnAceStatus
  924.         lngResult = ACECloseArchive(UnAcehndle)
  925.         Exit Function
  926.     End If
  927.  
  928.     Do Until UnAceStatus <> 0
  929.         lngDirFlag = utdHeader.FileAttrbute And 16
  930.         lngResult = ACEProcessFile(UnAcehndle, ACECMD_SKIP, CurDir$)
  931.         If lngResult = 131 Then
  932.             UnAceCheckArchiveEx = lngResult
  933.             Exit Do
  934.         End If
  935.         If lngDirFlag = 0 And lngResult = 0 Then Exit Do
  936.         UnAceStatus = ACEReadHeader(UnAcehndle, utdHeader)
  937.     Loop
  938.     
  939.     lngResult = ACECloseArchive(UnAcehndle)
  940. End Function
  941. Private Function IsNotAccessFile() As Boolean
  942.     Dim intFnum As Integer
  943.     Dim strBuffer As String
  944.     
  945.     On Error GoTo errorhndle
  946.     
  947.     intFnum = FreeFile()
  948.     strBuffer = String$(256, vbNullChar)
  949.     
  950.     Open mstrFileName For Binary Access Read As #intFnum
  951.         Get #intFnum, , strBuffer
  952.     Close #intFnum
  953.     
  954.     IsNotAccessFile = False
  955.     Exit Function
  956. errorhndle:
  957.     IsNotAccessFile = True
  958. End Function
  959. Private Function IsTarBrokenFile() As Boolean
  960.     Dim strBuffer As String
  961.     Dim lngResult As Long
  962.     
  963.     On Error GoTo errorhndle
  964.     
  965.     strBuffer = String$(512, vbNullChar)
  966.     If TarGetVersion <= 56 Then
  967.         lngResult = Tar(mTargethWnd, "tnf " & SetQuote(mstrFileName), strBuffer, 512)
  968.     Else
  969.         lngResult = TarGetArchiveType(mstrFileName)
  970.         Select Case lngResult
  971.             Case 0, -1
  972.                 IsTarBrokenFile = False
  973.             Case Else
  974.                 IsTarBrokenFile = True
  975.         End Select
  976.         Exit Function
  977.     End If
  978.     Select Case lngResult
  979.         Case Is <= 32799
  980.             If TarCheckArchive(mstrFileName, 0) <> 0 Then
  981.                 IsTarBrokenFile = True
  982.             Else
  983.                 IsTarBrokenFile = False
  984.             End If
  985.         Case Is >= 32800
  986.             IsTarBrokenFile = False
  987.     End Select
  988.     Exit Function
  989. errorhndle:
  990.     IsTarBrokenFile = False
  991. End Function
  992. Public Function GetFileExtention(ByVal strString As String) As String
  993. 'ègÆúÄqû╝é╠é▌ÆèÅoüB
  994. 'Exsample; "C:\List.txt" ü¿ "txt"
  995.     Dim i               As Long
  996.     Dim lngResult       As Long
  997.     Dim lngResultSecond As Long
  998.     
  999.     If InStr(strString, Chr$(46)) = 0 Then
  1000.         GetFileExtention = strString
  1001.         Exit Function
  1002.     End If
  1003.     
  1004.     For i = 1 To Len(strString)
  1005.         lngResult = InStr(i, strString, Chr$(46))
  1006.         If lngResult <> 0 Then
  1007.             lngResultSecond = lngResult
  1008.         End If
  1009.     Next i
  1010.     
  1011.     GetFileExtention = Mid$(strString, lngResultSecond + 1, Len(strString) - lngResultSecond)
  1012. End Function
  1013. Public Function GetFileExtRemove(ByVal strString As String) As String
  1014. 'âtâïâpâXé⌐éτègÆúÄqé≡Å£éóé╜âpâXé≡ĵô╛
  1015. 'Exsample; "C:\Windows\System\User32.DLL" ü¿ "C:\Windows\System\User32"
  1016.     Dim i               As Long
  1017.     Dim lngResult       As Long
  1018.     Dim lngResultSecond As Long
  1019.     
  1020.     For i = 1 To Len(strString)
  1021.         lngResult = InStr(i, strString, Chr$(46))
  1022.         If lngResult <> 0 Then
  1023.             lngResultSecond = lngResult
  1024.         End If
  1025.     Next i
  1026.     
  1027.     GetFileExtRemove = Mid$(strString, 1, lngResultSecond - 1)
  1028. End Function
  1029. Private Function GetShortPath() As String
  1030.     Dim lngResult As Long
  1031.     Dim strBuffer As String
  1032.     
  1033.     strBuffer = String$(512, vbNullChar)
  1034.     lngResult = GetShortPathName(mstrFileName, strBuffer, Len(strBuffer))
  1035.     If lngResult <> 0 Then
  1036.         GetShortPath = DelNullChr(strBuffer)
  1037.     Else
  1038.         GetShortPath = ""
  1039.     End If
  1040. End Function
  1041. Private Function SearchFile(ByVal strFileName As String, Optional strResPath As String) As Boolean
  1042.     Dim strBuffer As String
  1043.     Dim lngFilePart As Long
  1044.     strBuffer = String$(MAX_PATH, vbNullChar)
  1045.     SearchFile = SearchPath(vbNullString, _
  1046.                            strFileName, _
  1047.                            vbNullString, _
  1048.                            Len(strBuffer), _
  1049.                            strBuffer, _
  1050.                            lngFilePart)
  1051.     If SearchFile = False Then
  1052.         strResPath = ""
  1053.     Else
  1054.         strResPath = DelNullChr(strBuffer)
  1055.     End If
  1056. End Function
  1057. Private Function DelNullChr(ByVal strBuffer As String) As String
  1058.     If InStr(strBuffer, vbNullChar) > 0 Then
  1059.         DelNullChr = Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1)
  1060.     Else
  1061.         DelNullChr = strBuffer
  1062.     End If
  1063. End Function
  1064. Private Function IsFileExist(ByVal strFilePath As String) As Boolean
  1065.     Dim lngFileHandle As Long
  1066.     Dim utdWin32Data As WIN32_FIND_DATA
  1067.     
  1068.     lngFileHandle = FindFirstFile(strFilePath, utdWin32Data)
  1069.     If lngFileHandle = -1 Then
  1070.         IsFileExist = False
  1071.     Else
  1072.         IsFileExist = True
  1073.     End If
  1074.     
  1075.     Call FindClose(lngFileHandle)
  1076. End Function
  1077. Private Function SetQuote(ByVal strString As String) As String
  1078.     If InStr(strString, " ") Or InStr(strString, ",") Then
  1079.         SetQuote = """" & strString & """"
  1080.     Else
  1081.         SetQuote = strString
  1082.     End If
  1083. End Function
  1084. Private Function UnRarGetFileCountEx() As Long
  1085.     Dim lngRarhndle As Long
  1086.     Dim lngStatus As Long
  1087.     Dim lngResult As Long
  1088.     Dim intFCount As Long
  1089.     Dim utdRar As RAROpenArchiveData
  1090.     Dim utdRarHeader As RarHeaderData
  1091.     
  1092.     With utdRar
  1093.         .ArcName = GetShortPath
  1094.         .OpenMode = RAR_OM_LIST
  1095.         .CmtBuf = String$(256, vbNullChar)
  1096.         .CmtBufSize = 256
  1097.     End With
  1098.     
  1099.     lngRarhndle = RAROpenArchive(utdRar)
  1100.     
  1101.     If lngRarhndle = 0 Then
  1102.         UnRarGetFileCountEx = -1
  1103.         Exit Function
  1104.     End If
  1105.     
  1106.     lngStatus = RARReadHeader(lngRarhndle, utdRarHeader)
  1107.     
  1108.     Do Until lngStatus <> 0
  1109.         If (utdRarHeader.lngFileAttr And 16) = 0 Then
  1110.         intFCount = intFCount + 1
  1111.         End If
  1112.         lngResult = RARProcessFile(lngRarhndle, RAR_SKIP, "", "")
  1113.         If lngResult <> 0 Then
  1114.             UnRarGetFileCountEx = -1
  1115.             lngResult = RARCloseArchive(lngRarhndle)
  1116.             Exit Function
  1117.         End If
  1118.         lngStatus = RARReadHeader(lngRarhndle, utdRarHeader)
  1119.         If lngResult = ERAR_BAD_DATA Then
  1120.             UnRarGetFileCountEx = -1
  1121.             lngResult = RARCloseArchive(lngRarhndle)
  1122.             Exit Function
  1123.         End If
  1124.     Loop
  1125.     
  1126.     lngResult = RARCloseArchive(lngRarhndle)
  1127.     
  1128.     UnRarGetFileCountEx = intFCount
  1129. End Function
  1130. Private Function AceGetFileCountEx() As Long
  1131.     Dim lnghndle As Long
  1132.     Dim lngStatus As Long
  1133.     Dim lngResult As Long
  1134.     Dim intFCount As Long
  1135.     Dim utdAce As ACEOpenArchiveData
  1136.     Dim utdHeader As ACEHeaderData
  1137.     
  1138.     With utdAce
  1139.         .ArcName = GetShortPath
  1140.         .OpenMode = ACEOPEN_LIST
  1141.     End With
  1142.     
  1143.     lnghndle = ACEOpenArchive(utdAce)
  1144.     lngStatus = ACEReadHeader(lnghndle, utdHeader)
  1145.     
  1146.     Do Until lngStatus <> 0
  1147.         If (utdHeader.FileAttrbute And 16) = 0 Then
  1148.             intFCount = intFCount + 1
  1149.         End If
  1150.         lngResult = ACEProcessFile(lnghndle, ACECMD_SKIP, "")
  1151.         lngStatus = ACEReadHeader(lnghndle, utdHeader)
  1152.     Loop
  1153.     
  1154.     lngResult = ACECloseArchive(lnghndle)
  1155.     
  1156.     AceGetFileCountEx = intFCount
  1157. End Function
  1158. Public Function GetCountUnlha() As Long
  1159.     GetCountUnlha = UnlhaGetFileCount(mstrFileName)
  1160. End Function
  1161. Public Function GetCountCab() As Long
  1162.     GetCountCab = CabGetFileCount(mstrFileName)
  1163. End Function
  1164. Public Function GetCountUnZip() As Long
  1165.     GetCountUnZip = UnZipGetFileCount(mstrFileName)
  1166. End Function
  1167. Public Function GetCountUnRar() As Long
  1168.     GetCountUnRar = UnRarGetFileCountEx
  1169. End Function
  1170. Public Function GetCountUnAce() As Long
  1171.     GetCountUnAce = AceGetFileCountEx
  1172. End Function
  1173. Public Function GetCountBga() As Long
  1174.     GetCountBga = BgaGetFileCount(mstrFileName)
  1175. End Function
  1176. Public Function GetCountTar() As Long
  1177.     GetCountTar = TarGetFileCount(mstrFileName)
  1178. End Function
  1179. Public Function GetCountYz1() As Long
  1180.     GetCountYz1 = Yz1GetFileCount(mstrFileName)
  1181. End Function
  1182. Public Function GetCountUnGCA() As Long
  1183.     GetCountUnGCA = UnGCAGetFileCount(mstrFileName)
  1184. End Function
  1185. Public Function GetCountUnArj() As Long
  1186.     GetCountUnArj = UnarjGetFileCount(mstrFileName)
  1187. End Function
  1188.  
  1189.